home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xprolog2 / listing < prev    next >
Text File  |  1985-11-19  |  3KB  |  116 lines
  1. %
  2. %    listing predicate
  3. %
  4. %    for Xprolog 2.0
  5. %    by Andreas Toenne
  6.  
  7. % listing :-
  8. %    all known and not hidden procedures are written to the output
  9. %    stream. The output of listing can be reread.
  10. % listing(name) :-
  11. %    all known and not hidden procedures with the named head are
  12. %    written as in listing.
  13. % listing(ListOfNames) :-
  14. %    applies listing(name) to all members of the list.
  15.  
  16. listing :-
  17.     next_functor(Name, Arity),
  18.     functor(Head, Name, Arity),        % construct clause head
  19.     clause(Head, Body),            % find matching clause
  20.     check_for_new_procedure(Name, Arity),    % nl if new procedure
  21.     nl,
  22.     write_clause(Head, Body),        % output the clause
  23.     fail.                    % search for next solution
  24. listing :- nl.
  25.  
  26. listing(X) :- var(X), !.            % don't list variables
  27. listing([]) :- !.                % stop at empty list
  28. listing([Name|Names]) :-
  29.     !,
  30.     listing(Name),
  31.     listing(Names).
  32. listing(Name) :-
  33.     next_functor(Name, Arity),
  34.     functor(Head, Name, Arity),
  35.     clause(Head, Body),
  36.     check_for_new_procedure(Name, Arity),
  37.     nl,
  38.     write_clause(Head, Body),
  39.     fail.
  40. listing(_) :- nl.
  41.  
  42. next_functor(Name, Arity) :- $functor(Name, Arity, Help).
  43.  
  44. check_for_new_procedure(Name, Arity) :-        % no changes
  45.     lastlisted(Name, Arity),
  46.     !.
  47. check_for_new_procedure(Name, Arity) :-        % new procedure
  48.     retract(lastlisted(_,_)),
  49.     assert(lastlisted(Name, Arity)),
  50.     nl.
  51.     
  52. write_clause(Head, true) :-
  53.     writeq(Head),
  54.     put(['.']),
  55.     !.
  56. write_clause(Head, Body) :-
  57.     writeq(Head),
  58.     write(' :- '),
  59.     write_body(Body, 8, start),
  60.     put(['.']),
  61.     !.
  62.     
  63. write_body(X, _, _) :-                % Xprolog has no variable terms
  64.     var(X),
  65.     nl,
  66.     !,
  67.     write('***** variable goal is bad *****').
  68. write_body((A,B), Tab, _) :-
  69.     !,
  70.     write_body(A, Tab, comma),
  71.     put([',']),
  72.     write_body(B, Tab, comma).
  73. write_body((A;B), Tab, FromWhere) :-
  74.     (
  75.         FromWhere = start
  76.         ;
  77.         FromWhere = semicolon
  78.     ),
  79.     !,
  80.     write_body(A, Tab, semicolon),
  81.     nl,
  82.     tab(Tab),
  83.     put([';']),
  84.     write_body(B, Tab, semicolon).
  85. write_body((A;B), Tab, _) :-
  86.     !,
  87.     nl,
  88.     tab(Tab),
  89.     put(['(']),
  90.     NewTab is Tab + 8,
  91.     write_body(A, NewTab, semicolon),
  92.     nl,
  93.     tab(NewTab),
  94.     put([';']),
  95.     write_body(B, NewTab, semicolon),
  96.     nl,
  97.     tab(Tab),
  98.     put([')']).
  99. write_body(X, _, start) :-            % simple body
  100.     !,
  101.     writeq(X).
  102. write_body(X, Tab, _) :-
  103.     !,
  104.     nl,
  105.     tab(Tab),
  106.     writeq(X).
  107.  
  108. lastlisted(foo, foo).                % for output formatting
  109.  
  110. % hide all new procedures
  111.  
  112. :- hide([listing, listing(_), next_functor(_,_), check_for_new_procedure(_,_),
  113.      write_clause(_,_), write_body(_,_,_), lastlisted(_,_)]).
  114.  
  115.  
  116.